Celestin Apprentice 7/Apprentice-Release7.iso/Demos/Component Software/FileFlex 2.0.3.sit/FileFlex 2.0.3/FileFlex-Director/FileFlex Xtras/-Validation Suite/00002_performTests.ls

Text File | 1996-07-21 | 17.6 KB | 739 lines

on startMovie
  global dgBlueColor, dgYellowColor, dgMonospace, dgMonosize
  put EMPTY into field "mmsg"
  put EMPTY into field "iteration"
  set the text of cast "testName" to EMPTY
  if the machineType = 256 then
    set dgMonospace to "Courier New"
    set dgMonosize to 10
  else
    set dgMonospace to "Monaco"
    set dgMonosize to 9
  end if
  set dgBlueColor to the foreColor of member "blueModel"
  set dgYellowColor to the foreColor of member "yellowModel"
  set dgDkBlueColor to the foreColor of member "dkBlueModel"
  set the textHeight of member "mmsg" to 11
  set the textFont of member "mmsg" to dgMonospace
  set the textSize of member "mmsg" to dgMonosize
  set the foreColor of member "mmsg" to dgYellowColor
  set the textFont of member "testName" to "Helvetica"
  set the textSize of member "testName" to 9
  set the foreColor of member "testName" to dgYellowColor
  put "0" into field "iteration"
  set the textFont of member "iteration" to "Helvetica"
  set the textSize of member "iteration" to 9
  set the foreColor of member "iteration" to dgBlueColor
end

on closeWindow
  set theList to the windowList
  repeat with i = 1 to count(theList)
    set theItem to string(getAt(theList, i))
    delete word 1 of theItem
    delete char 1 of theItem
    set theChar to the number of chars in theItem
    delete char theChar - 1 to theChar of theItem
    if (theItem contains "Validation Suite") or (theItem contains "FFVERIF") then
      forget(window theItem)
    end if
  end repeat
  tell the stage
    puppetPalette(0)
  end tell
  tell the stage
    updateStage()
  end tell
end

on performTests
  global gDBActive1030, dgBlueColor, dgYellowColor, dgMonospace, dgMonosize, verboseTest
  if gDBActive1030 = "true" then
    set DBResult to DBCloseSession()
    if DBResult < 0 then
      tmsg("==== Session was active.  DBCloseSession reset failed.")
      tFail()
    end if
  end if
  set blueHold to dgBlueColor
  set yellowHold to dgYellowColor
  set monoHold to dgMonospace
  set monoSize to dgMonosize
  clearGlobals()
  set dgBlueColor to blueHold
  set dgYellowColor to yellowHold
  set dgMonospace to monoHold
  set dgMonosize to monoSize
  set verboseTest to 0
  put EMPTY into field "iteration"
  put EMPTY into field "mmsg"
  put DBVersion() & RETURN into field "mmsg"
  set the textFont of member "mmsg" to dgMonospace
  set the textSize of member "mmsg" to dgMonosize
  set the textHeight of member "mmsg" to 11
  set the foreColor of member "mmsg" to dgYellowColor
  set origMasterBytes to the freeBytes
  set origMasterBlock to the freeBlock
  tXtraTest()
  set the textFont of member "testName" to "Helvetica"
  set the textSize of member "testName" to 9
  set the foreColor of member "testName" to dgBlueColor
  set the textFont of member "iteration" to "Helvetica"
  set the textSize of member "iteration" to 9
  set the foreColor of member "iteration" to dgBlueColor
  tGlobalVariables()
  tDBOpenSession()
  tDBCloseSession()
  tDBOpenSessionStressTest()
  tDBOpenSession()
  tDBUse("VIDEO.DBF")
  tDBClose("1")
  tDBDatabaseExists("VIDEO.DBF")
  tDBUse("VIDEO.DBF")
  tDBCloseAll()
  tDBUse("VIDEO.DBF")
  tDBListFields()
  tDBCount()
  tDBBottom()
  tDBCurrRecNum(31)
  tDBTop()
  tDBCurrRecNum(1)
  tDBGo()
  tDBCurrRecNum(18)
  tRetrieveChar()
  tRetrieveNum()
  tRetrieveLogical()
  tRetrieveDate()
  tRetrieveMemo()
  tDBGetCurrRecValG()
  tDBSum()
  tDBCloseAll()
  tDBUse("VIDEO.DBF")
  tDBLocate()
  tDBClose("1")
  tDBUse("VIDEO.DBF")
  tDBCreateIndex()
  tDBCheckIndex()
  tDBReindex()
  tDBSeek()
  tDBClose("1")
  tDBCreate()
  tDBWriteRecG()
  tDBFindMemo()
  tDBZapRecs()
  tDBWriteRecX()
  tDBZapRecs()
  tDBCloseAll()
  tDBEncrypt()
  tDBCreateMany()
  tDBCloseAll()
  tDBWriteRecManyX()
  tDBCloseSession()
  put EMPTY into field "iteration"
  set newBytes to the freeBytes
  set theBytes to origMasterBytes - newBytes
  tmsg("== End of test sequence:")
  tmsg("==== Overall test consumed" && theBytes && "bytes.")
  tmsg("==== The largest contiguous free block at start")
  tmsg("==== was" && origMasterBlock && "bytes.")
  tmsg(EMPTY)
  tmsg("==== The largest contiguous remaining free block")
  tmsg("==== is" && the freeBlock && "bytes.")
  tmsg(EMPTY)
  tmsg(EMPTY)
  put EMPTY into field "iteration"
  set the text of cast "testName" to EMPTY
  beep()
end

on tXtraTest
  global dgBlueColor
  put EMPTY into field "iteration"
  set max to field "iterations"
  tTest("Loading of Xtra")
  repeat with i = 1 to max
    set dummy to DBVersion()
    put i into field "iteration"
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
  end repeat
  tPass()
end

on tGlobalVariables
  global dgBlueColor, testGlobal1, testGlobal2, theLong, theDouble
  set max to field "iterations"
  put EMPTY into field "iteration"
  tTest("Global Variable Interface")
  set testFail to 0
  repeat with i = 1 to max
    set dummy to DBSetGlobal("testGlobal1", "TestData")
    set dummy to DBSetGlobal("testGlobal2", "Test2Data")
    set theGlob1 to DBGetGlobal("testGlobal1")
    if theGlob1 <> "TestData" then
      tmsg(RETURN & "==== testGlobal1 returned" && theGlob1)
      set testFail to 1
      exit repeat
    end if
    set theGlob2 to DBGetGlobal("testGlobal2")
    if theGlob2 <> "Test2Data" then
      tmsg(RETURN & "==== testGlobal2 returned" && theGlob2)
      set testFail to 1
      exit repeat
    end if
    set theLong to 896
    set theDouble to 493.22000000000002728
    set theLongResult to DBGetGlobal("theLong")
    if theLongResult <> 896 then
      set testFail to 1
      exit repeat
    end if
    set theDoubleResult to DBGetGlobal("theDouble")
    if string(theDoubleResult) <> "493.22" then
      set testFail to 1
      exit repeat
    end if
    put i into field "iteration"
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
  end repeat
  if testFail = 1 then
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBOpenSession
  tTest("DBOpenSession")
  set DBResult to DBOpenSession()
  if DBResult = 0 then
    tPass()
  else
    tmsg("== DBOpenSession returned" && DBResult & ".")
    tFail()
    exit
  end if
end

on tDBCloseSession
  tTest("DBCloseSession")
  set DBResult to DBCloseSession()
  if DBResult = 0 then
    tPass()
  else
    tmsg("== DBCloseSession returned" && DBResult & ".")
    tFail()
    exit
  end if
end

on tDBOpenSessionStressTest
  global dgBlueColor
  tTest("DBOpenSession/DBCloseSession Stress")
  set max to field "iterations"
  put EMPTY into field "iteration"
  repeat with i = 1 to max
    put i into field "iteration"
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
    set DBResult to DBOpenSession()
    if DBResult < 0 then
      tmsg("==== DBOpenSession returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
    set DBResult to DBCloseSession()
    if DBResult < 0 then
      tmsg("==== DBCloseSession returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
  end repeat
  tPass()
end

on tDBUse theFile
  tTest("DBUse")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:" & theFile
  else
    set theDBFile to the moviePath & "TESTDATA\" & theFile
  end if
  set videoID to DBUse(theDBFile)
  if videoID < 0 then
    tmsg("==== DBUse returned" && videoID & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBClose videoID
  tTest("DBClose")
  set DBResult to DBClose(videoID)
  if videoID < 0 then
    tmsg("==== DBClose returned" && videoID & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBDatabaseExists theFile
  tTest("DBDatabaseExists")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:" & theFile
  else
    set theDBFile to the moviePath & "TESTDATA\" & theFile
  end if
  set theID to DBDatabaseExists(theDBFile)
  if theID < 0 then
    tmsg("==== DBDatabaseExists returned" && theID & ".  (failed)")
    tFail()
    exit
  end if
  set theID to DBDatabaseExists("nosuchfile")
  if theID >= 0 then
    tmsg("==== DBDatabaseExists returned" && theID & ".  (failed)")
    tFail()
    exit
  end if
  tPass()
end

on tDBCloseAll
  tTest("DBCloseAll on one open database")
  set DBResult to DBCloseAll()
  if DBResult < 0 then
    tmsg("==== DBCloseAll returned" && DBResult & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBListFields
  tTest("DBListFields (for one file)")
  set theFields to DBListFields()
  if theFields <> field "videoDBFschema" then
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBCount
  tTest("DBCount")
  set theCount to DBCount()
  if theCount <> 31 then
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBBottom
  tTest("DBBottom")
  set theResult to DBBottom()
  if theResult < 0 then
    tmsg("==== DBBottom returned" && theResult & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBCurrRecNum theNum
  tTest("DBCurrRecNum")
  set theResult to DBCurrRecNum()
  if theResult <> theNum then
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBTop
  tTest("DBTop")
  set theResult to DBTop()
  if theResult < 0 then
    tmsg("==== DBTop returned" && theResult & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBLocate
  tTest("DBLocate")
  set theResult to DBTop()
  set DBResult to DBLocate("TITLE = 'GHOSTBUSTERS'")
  if DBResult <> 0 then
    tFail()
  else
    if DBCurrRecNum() <> 21 then
      tFail()
    else
      tPass()
    end if
  end if
  set dummy to DBTop()
end

on tDBGo
  tTest("DBGo")
  set theResult to DBGo(18)
  if theResult < 0 then
    tmsg("==== DBGo returned" && theResult & ".  (failed)")
    tFail()
    exit
  else
    tPass()
  end if
end

on tRetrieveChar
  tTest("Retrieve Character (C) field")
  set theResult to DBGetFieldByName("TITLE")
  if theResult <> "A NIGHTMARE ON ELM STREET" then
    tFail()
    exit
  else
    tPass()
  end if
end

on tRetrieveNum
  tTest("Retrieve Numeric (N) field")
  set theResult to DBGetFieldByName("COST_BUY")
  if theResult <> 29.94999999999999929 then
    tFail()
    exit
  else
    tPass()
  end if
end

on tRetrieveLogical
  tTest("Retrieve Logical (L) field")
  set theResult to DBGetFieldByName("AVAILABLE")
  if theResult <> "F" then
    tFail()
    exit
  else
    tPass()
  end if
end

on tRetrieveDate
  tTest("Retrieve Date (D) field")
  set theResult to DBGetFieldByName("DATE_ARRIV")
  if theResult <> "19860314" then
    tFail()
    exit
  else
    tPass()
  end if
end

on tRetrieveMemo
  tTest("DBGetMemo")
  set theResult to DBGetMemo("DESCRIPT")
  if theResult <> the text of cast "testMemoData" then
    tFail()
    exit
  else
    tPass()
  end if
end

on tDBSum
  tTest("DBSum")
  set fp to the floatPrecision
  set the floatPrecision to 2
  set theResult to DBSum("COST_RENT")
  if theResult <> 98.95000000000000284 then
    tFail()
  else
    set theResult to DBSum("COST_BUY")
    if theResult <> 984.51999999999998181 then
      tFail()
    else
      tPass()
    end if
  end if
  set the floatPrecision to fp
end

on tDBGetCurrRecValG
  global title, COST_BUY, AVAILABLE, DATE_ARRIV, DESCRIPT
  tTest("DBGetCurrRecVal(G)")
  set theResult to DBGetCurrRecVal("G")
  if title <> "A NIGHTMARE ON ELM STREET" then
    tmsg("==== DBGetCurrRecVal(G) character data mismatch.  (failed)")
    tFail()
    exit
  end if
  if COST_BUY <> 29.94999999999999929 then
    tmsg("==== DBGetCurrRecVal(G) numeric data mismatch.  (failed)")
    tFail()
    exit
  end if
  if AVAILABLE <> "F" then
    tmsg("==== DBGetCurrRecVal(G) logical data mismatch.  (failed)")
    tFail()
    exit
  end if
  if DATE_ARRIV <> "19860314" then
    tmsg("==== DBGetCurrRecVal(G) date data mismatch.  (failed)")
    tFail()
    exit
  end if
  if DESCRIPT <> the text of cast "testMemoData" then
    tmsg("==== DBGetCurrRecVal(G) memo data mismatch.  (failed)")
    tFail()
    exit
  end if
  tPass()
end

on tDBCreate
  tTest("DBCreate")
  set schema to "CHAR_FLD,C,25"
  put RETURN & "NUM_FLD,N,8,3" after schema
  put RETURN & "MEMO_FLD,M" after schema
  set theDBFile to the moviePath & "TEST01"
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:TEST01"
  else
    set theDBFile to the moviePath & "TESTDATA\TEST01"
  end if
  set DBResult to DBCreate(theDBFile, 3, schema, "false")
  if DBResult < 0 then
    tmsg("==== dbResult returned" && DBResult & ".  (failed)")
    tFail()
    exit
  end if
  set DBResult to DBCloseAll()
  if DBResult < 0 then
    tmsg("==== DBCloseAll returned" && DBResult & ".  (failed)")
    tFail()
    exit
  end if
  set videoID to DBUse(theDBFile)
  if videoID < 0 then
    tmsg("==== DBUse returned" && videoID & ".  (failed)")
    tFail()
    exit
  end if
  set theFields to DBListFields()
  set fieldCheck to "3" & RETURN & "CHAR_FLD,C,25,0"
  put RETURN & "NUM_FLD,N,8,3" after fieldCheck
  put RETURN & "MEMO_FLD,M,10,0" & RETURN after fieldCheck
  if theFields <> fieldCheck then
    tmsg("==== DBCreate's fields don't match .  (failed)")
    tFail()
    exit
  end if
  tPass()
end

on tDBWriteRecG
  global dgBlueColor, CHAR_FLD, NUM_FLD, MEMO_FLD
  set max to field "iterations"
  put EMPTY into field "iteration"
  tTest("DBWriteRec(G)")
  repeat with i = 1 to max
    set the textFont of member "iteration" to "Helvetica"
    set the textSize of member "iteration" to 9
    set the foreColor of member "iteration" to dgBlueColor
    put i into field "iteration"
    set NUM_FLD to string(integer(i))
    set CHAR_FLD to "Loop [" & integer(i) & "]"
    set MEMO_FLD to "[" & integer(i) & "]" && the text of cast "testMemoData"
    set theRec to DBCurrRecNum() + 1
    set DBResult to DBWriteRec("G", theRec)
    if DBResult < 0 then
      tmsg("==== DBWriteRec(G) returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
  end repeat
  set numRecs to DBCount()
  if numRecs <> max then
    tmsg("==== DBWriteRec(G) had wrong total record count.  (failed)")
    tFail()
    exit
  end if
  repeat with i = max down to 1
    put integer(i) into field "iteration"
    set DBResult to DBGo(i)
    if DBResult < 0 then
      tmsg("==== DBGo returned" && DBResult & ".  (failed)")
      tFail()
      exit
    end if
    set CHAR_FLD to EMPTY
    set NUM_FLD to EMPTY
    set MEMO_FLD to EMPTY
    set DBResult to DBGetCurrRecVal("G")
    set NUM_FLDx to i
    set CHAR_FLDx to "Loop [" & integer(i) & "]"
    set MEMO_FLDx to "[" & integer(i) & "]" && the text of cast "testMemoData"
    if NUM_FLDx <> NUM_FLD then
      tmsg(EMPTY)
      tmsg("==== Numeric data retrieval mismatch.  (failed)")
      tmsg("==== NUM_FLD is [" & NUM_FLD & "].")
      tmsg("==== NUM_FLD should be [" & NUM_FLDx & "].")
      tFail()
      exit
    end if
    if CHAR_FLDx <> CHAR_FLD then
      tmsg("==== Character data retrieval mismatch.  (failed)")
      tmsg("==== CHAR_FLD is [" & CHAR_FLD & "].")
      tmsg("==== CHAR_FLD should be [" & CHAR_FLDx & "].")
      tFail()
      exit
    end if
    if MEMO_FLDx <> MEMO_FLD then
      tmsg("==== Memo data retrieval mismatch.  (failed)")
      tFail()
      exit
    end if
  end repeat
  tPass()
end

on tDBFindMemo
  set max to field "iterations"
  if max > 20 then
    tTest("DBFindMemo")
    set DBResult to DBTop()
    set searchStr to "[18] Starring"
    set DBResult to DBFindMemo("MEMO_FLD", searchStr)
    if DBResult < 0 then
      tFail()
    else
      if DBCurrRecNum() <> 18 then
        tFail()
      else
        tPass()
      end if
    end if
  end if
end

on tDBZapRecs
  put EMPTY into field "iteration"
  tTest("DBZapRecs")
  set theCount to DBCount()
  if theCount <> field "iterations" then
    tmsg("==== Incorrect record count.  (failed)")
    tFail()
    exit
  end if
  set DBResult to DBZapRecs(1, theCount)
  if DBResult < 0 then
    tFail()
    exit
  end if
  tPass()
end

on tDBEncrypt
  tTest("DBEncrypt/DBDecrypt")
  set theS to "This is a test"
  set theEncryptS to DBEncrypt(theS, "mykey")
  set theS2 to DBDecrypt(theEncryptS, "mykey")
  if theS <> theS2 then
    tFail()
  else
    tPass()
  end if
end

on tDBCreateIndex
  tTest("DBCreateIndex")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:VIDNAME"
  else
    set theDBFile to the moviePath & "TESTDATA\VIDNAME"
  end if
  set indexID to DBCreateIndex(theDBFile, "UPPER(TITLE)", "0", "0")
  if indexID < 0 then
    tFail()
  else
    set DBResult to DBCloseIndex(indexID)
    if DBResult < 0 then
      tFail()
    else
      tPass()
    end if
  end if
end

on tDBCheckIndex
  tTest("DBCheckIndex")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:VIDNAME"
  else
    set theDBFile to the moviePath & "TESTDATA\VIDNAME"
  end if
  set indexID to DBUseIndex(theDBFile)
  if indexID < 0 then
    tFail()
  else
    set DBResult to DBCheckIndex(indexID)
    if DBResult < 0 then
      tmsg("==== Check index result code: " & DBResult)
      tFail()
    else
      set DBResult to DBCloseIndex(indexID)
      if DBResult < 0 then
        tmsg("==== Close index result code: " & DBResult)
        tFail()
      else
        tPass()
      end if
    end if
  end if
end

on tDBReindex
  tTest("DBReindex")
  if the machineType <> 256 then
    set theDBFile to the moviePath & "Test Data:VIDNAME"
  else
    set theDBFile to the moviePath & "TESTDATA\VIDNAME"
  end if
  set indexID to DBUseIndex(theDBFile)
  if indexID < 0 then
    tFail()
  else
    set DBResult to DBReindex(indexID)
    if DBResult < 0 then
      tFail()
    else
      set DBResult to DBCloseIndex(indexID)
      if DBResult < 0 then
        tFail()
      else
        tPass()
      end if
    end if
  end if
end